home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / vm / vm-startup.el < prev    next >
Encoding:
Text File  |  1995-08-18  |  32.5 KB  |  948 lines

  1. ;;; Entry points for VM
  2. ;;; Copyright (C) 1994, 1995 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (provide 'vm-startup)
  19.  
  20. (defun vm (&optional folder read-only)
  21.   "Read mail under Emacs.
  22. Optional first arg FOLDER specifies the folder to visit.  It defaults
  23. to the value of vm-primary-inbox.  The folder buffer is put into VM
  24. mode, a major mode for reading mail.
  25.  
  26. Prefix arg or optional second arg READ-ONLY non-nil indicates
  27. that the folder should be considered read only.  No attribute
  28. changes, messages additions or deletions will be allowed in the
  29. visited folder.
  30.  
  31. Visiting the primary inbox causes any contents of the system mailbox to
  32. be moved and appended to the resulting buffer.
  33.  
  34. All the messages can be read by repeatedly pressing SPC.  Use `n'ext and
  35. `p'revious to move about in the folder.  Messages are marked for
  36. deletion with `d', and saved to another folder with `s'.  Quitting VM
  37. with `q' expunges deleted messages and saves the buffered folder to
  38. disk.
  39.  
  40. See the documentation for vm-mode for more information."
  41.   (interactive (list nil current-prefix-arg))
  42.   (vm-session-initialization)
  43.   ;; set inhibit-local-variables non-nil to protect
  44.   ;; against letter bombs.
  45.   ;; set enable-local-variables to nil for newer Emacses
  46.   (catch 'done
  47.     (let ((full-startup (not (bufferp folder)))
  48.       folder-buffer first-time totals-blurb
  49.       preserve-auto-save-file)
  50.       (setq folder-buffer
  51.         (if (bufferp folder)
  52.         folder
  53.           (let ((file (or folder (expand-file-name vm-primary-inbox
  54.                                vm-folder-directory))))
  55.         (if (file-directory-p file)
  56.             ;; MH code perhaps... ?
  57.             (error "%s is a directory" file)
  58.           (or (vm-get-file-buffer file)
  59.               (let ((default-directory
  60.                   (or (and vm-folder-directory
  61.                        (expand-file-name vm-folder-directory))
  62.                   default-directory))
  63.                 (inhibit-local-variables t)
  64.                 (enable-local-variables nil))
  65.             (vm-unsaved-message "Reading %s..." file)
  66.             (prog1 (find-file-noselect file)
  67.               ;; update folder history
  68.               (let ((item (or folder vm-primary-inbox)))
  69.                 (if (not (equal item (car vm-folder-history)))
  70.                 (setq vm-folder-history
  71.                       (cons item vm-folder-history))))
  72.               (vm-unsaved-message "Reading %s... done" file))))))))
  73.       (set-buffer folder-buffer)
  74.       (vm-check-for-killed-summary)
  75.       ;; If the buffer's not modified then we know that there can be no
  76.       ;; messages in the folder that are not on disk.
  77.       (or (buffer-modified-p) (setq vm-messages-not-on-disk 0))
  78.       (setq first-time (not (eq major-mode 'vm-mode))
  79.         preserve-auto-save-file (and buffer-file-name
  80.                       (not (buffer-modified-p))
  81.                       (file-newer-than-file-p
  82.                        (make-auto-save-file-name)
  83.                        buffer-file-name)))
  84.       ;; Force the folder to be read only if the auto
  85.       ;; save file contains information the user might not
  86.       ;; want overwritten, i.e. recover-file might be
  87.       ;; desired.  What we want to avoid is an auto-save.
  88.       ;; Making the folder read only will keep it
  89.       ;; subsequent actions from modifying the buffer in a
  90.       ;; way that triggers an auto save.
  91.       ;;
  92.       ;; Also force the folder read-only if it was read only and
  93.       ;; not already in vm-mode, since there's probably a good
  94.       ;; reason for this.
  95.       (setq vm-folder-read-only (or preserve-auto-save-file read-only
  96.                     (default-value 'vm-folder-read-only)
  97.                     (and first-time buffer-read-only)))
  98.       ;; If this is not a VM mode buffer then some initialization
  99.       ;; needs to be done 
  100.       (if first-time
  101.       (progn
  102.         (if (fboundp 'buffer-disable-undo)
  103.         (buffer-disable-undo (current-buffer))
  104.           ;; obfuscation to make the v19 compiler not whine
  105.           ;; about obsolete functions.
  106.           (let ((x 'buffer-flush-undo))
  107.         (funcall x (current-buffer))))
  108.         (abbrev-mode 0)
  109.         (auto-fill-mode 0)
  110.         (vm-mode-internal)))
  111.       (vm-assimilate-new-messages nil t)
  112.       (if first-time
  113.       (progn
  114.         (vm-gobble-visible-header-variables)
  115.         (vm-gobble-bookmark)
  116.         (vm-gobble-summary)
  117.         (vm-gobble-labels)
  118.         (vm-start-itimers-if-needed)))
  119.  
  120.       ;; make a new frame if the user wants one.  reuse an
  121.       ;; existing frame that is showing this folder.
  122.       (if (and full-startup
  123.            vm-frame-per-folder
  124.            (vm-multiple-frames-possible-p)
  125.            ;; this so that "emacs -f vm" doesn't create a frame.
  126.            this-command)
  127.       (let ((w (or (vm-get-buffer-window (current-buffer))
  128.                ;; summary == folder for the purpose
  129.                ;; of frame reuse.
  130.                (and vm-summary-buffer
  131.                 (vm-get-buffer-window vm-summary-buffer)))))
  132.         (if (null w)
  133.         (progn
  134.           (if folder
  135.               (vm-goto-new-frame 'folder)
  136.             (vm-goto-new-frame 'primary-folder 'folder))
  137.           (vm-set-hooks-for-frame-deletion))
  138.           (save-excursion
  139.         (select-window w)
  140.         (and vm-warp-mouse-to-new-frame
  141.              (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))
  142.       
  143.       ;; say this NOW, before the non-previewers read a message,
  144.       ;; alter the new message count and confuse themselves.
  145.       (if full-startup
  146.       ;; save blurb so we can repeat it later as necessary.
  147.       (setq totals-blurb (vm-emit-totals-blurb)))
  148.  
  149.       (vm-thoughtfully-select-message)
  150.       (if vm-message-list
  151.       (vm-preview-current-message)
  152.     (vm-update-summary-and-mode-line))
  153.       (if full-startup
  154.       (vm-display (current-buffer) t nil nil))
  155.       ;; need to do this after any frame creation because the
  156.       ;; toolbar sets frame-specific height and width specifiers.
  157.       (and (vm-toolbar-support-possible-p) vm-use-toolbar
  158.        (progn
  159.          (vm-toolbar-install-toolbar)
  160.          (vm-toolbar-update-toolbar)))
  161.  
  162.       (and vm-use-menus (vm-menu-support-possible-p)
  163.        (vm-menu-install-visited-folders-menu))
  164.  
  165.       (if full-startup
  166.       (save-excursion
  167.         (vm-display (current-buffer) t nil nil)
  168.         (if    (and (vm-should-generate-summary)
  169.              ;; don't generate a summary if recover-file is
  170.              ;; likely to happen, since recover-file does
  171.              ;; nothing useful in a summary buffer.
  172.              (not preserve-auto-save-file))
  173.         (vm-summarize t))
  174.         ;; People were confused that (vm) behaved differently
  175.         ;; than M-x vm.  We used to list all the various VM
  176.         ;; startup commands here, but now we just accept any
  177.         ;; command and treat it as if it were VM.  It's
  178.         ;; probably just as well, since any command that
  179.         ;; calls VM probably does want the window
  180.         ;; configuration to be setup.
  181.         (vm-display nil nil (list this-command)
  182.             (list (or this-command 'vm) 'startup))))
  183.  
  184.       (run-hooks 'vm-visit-folder-hook)
  185.  
  186.       (if full-startup
  187.       (message totals-blurb))
  188.       ;; Warn user about auto save file, if appropriate.
  189.       (if (and full-startup preserve-auto-save-file)
  190.       (message 
  191.        (substitute-command-keys
  192.         "Auto save file is newer; consider \\[recover-file].  FOLDER IS READ ONLY.")))
  193.       ;; if we're not doing a full startup or if doing more would
  194.       ;; trash the auto save file that we need to preserve,
  195.       ;; stop here.
  196.       (if (or (not full-startup) preserve-auto-save-file)
  197.       (throw 'done t))
  198.       (if (and vm-auto-get-new-mail
  199.            (not vm-block-new-mail)
  200.            (not vm-folder-read-only))
  201.       (progn
  202.         (vm-unsaved-message "Checking for new mail for %s..."
  203.                 (or buffer-file-name (buffer-name)))
  204.         (if (and (vm-get-spooled-mail) (vm-assimilate-new-messages t))
  205.         (progn
  206.           (setq totals-blurb (vm-emit-totals-blurb))
  207.           (if (vm-thoughtfully-select-message)
  208.               (vm-preview-current-message)
  209.             (vm-update-summary-and-mode-line))))
  210.         (message totals-blurb)))
  211.  
  212.       ;; Display copyright and copying info unless
  213.       ;; user says no.
  214.       ;; Check this-command so we don't make the user wait if
  215.       ;; they call vm non-interactively from some other program.
  216.       (if (and (not vm-inhibit-startup-message)
  217.            (not vm-startup-message-displayed)
  218.            (or (memq this-command '(vm vm-visit-folder))
  219.            ;; for emacs -f vm
  220.            (null last-command)))
  221.       (progn
  222.         (vm-display-startup-message)
  223.         (if (not (input-pending-p))
  224.         (message totals-blurb)))))))
  225.  
  226. (defun vm-other-frame (&optional folder read-only)
  227.   "Like vm, but run in a newly created frame."
  228.   (interactive (list nil current-prefix-arg))
  229.   (vm-session-initialization)
  230.   (if (vm-multiple-frames-possible-p)
  231.       (if folder
  232.       (vm-goto-new-frame 'folder)
  233.     (vm-goto-new-frame 'primary-folder 'folder)))
  234.   (let ((vm-frame-per-folder nil)
  235.     (vm-search-other-frames nil))
  236.     (vm folder read-only))
  237.   (if (vm-multiple-frames-possible-p)
  238.       (vm-set-hooks-for-frame-deletion)))
  239.  
  240. (defun vm-other-window (&optional folder read-only)
  241.   "Like vm, but run in a different window."
  242.   (interactive (list nil current-prefix-arg))
  243.   (vm-session-initialization)
  244.   (if (one-window-p t)
  245.       (split-window))
  246.   (other-window 1)
  247.   (let ((vm-frame-per-folder nil)
  248.     (vm-search-other-frames nil))
  249.     (vm folder read-only)))
  250.  
  251. (put 'vm-mode 'mode-class 'special)
  252.  
  253. (defun vm-mode (&optional read-only)
  254.   "Major mode for reading mail.
  255.  
  256. This is VM 5.95 (beta).
  257.  
  258. Commands:
  259.    h - summarize folder contents
  260.  C-t - toggle threads display
  261.  
  262.    n - go to next message
  263.    p - go to previous message
  264.    N - like `n' but ignores skip-variable settings
  265.    P - like `p' but ignores skip-variable settings
  266.  M-n - go to next unread message
  267.  M-p - go to previous unread message
  268.  RET - go to numbered message (uses prefix arg or prompts in minibuffer)
  269.  TAB - go to last message seen
  270.    ^ - go to parent of this message
  271.  M-s - incremental search through the folder
  272.  
  273.    t - display hidden headers
  274.  SPC - expose message body or scroll forward a page
  275.    b - scroll backward a page
  276.    < - go to beginning of current message
  277.    > - go to end of current message
  278.  
  279.    d - delete message, prefix arg deletes messages forward
  280.  C-d - delete message, prefix arg deletes messages backward
  281.    u - undelete
  282.    k - flag for deletion all messages with same subject as the current message
  283.  
  284.    r - reply (only to the sender of the message)
  285.    R - reply with included text from the current message
  286.  M-r - extract and resend bounced message
  287.    f - followup (reply to all recipients of message)
  288.    F - followup with included text from the current message
  289.    z - forward the current message
  290.    m - send a message
  291.    B - resend the current message to another user.
  292.    c - continue composing the most recent message you were composing
  293.  
  294.    @ - digestify and mail entire folder contents (the folder is not modified)
  295.    * - burst a digest into individual messages, and append and assimilate these
  296.        message into the current folder.
  297.  
  298.    G - sort messages by various keys
  299.  
  300.    g - get any new mail that has arrived in the system mailbox
  301.        (new mail is appended to the disk and buffer copies of the
  302.        primary inbox.)
  303.    v - visit another mail folder
  304.  
  305.    e - edit the current message
  306.    j - discard cached information about the current message
  307.  
  308.    s - save current message in a folder (appends if folder already exists)
  309.    w - write current message to a file without its headers (appends if exists)
  310.    S - save entire folder to disk, does not expunge
  311.    A - save unfiled messages to their vm-auto-folder-alist specified folders
  312.    # - expunge deleted messages (without saving folder)
  313.    q - quit VM, deleted messages are not expunged, folder is
  314.        saved to disk if it is modified.  new messages are changed
  315.        to be flagged as just unread.
  316.    x - exit VM with no change to the folder
  317.  
  318.  M N - use marks; the next vm command will affect only marked messages
  319.        if it makes sense for the command to do so
  320.  
  321.        M M - mark the current message
  322.        M U - unmark the current message
  323.        M m - mark all messages
  324.        M u - unmark all messages
  325.        M C - mark messages matches by a virtual folder selector
  326.        M c - unmark messages matches by a virtual folder selector
  327.        M T - mark thread tree rooted at the current message
  328.        M t - unmark thread tree rooted at the current message
  329.        M S - mark messages with the same subject as the current message
  330.        M s - unmark messages with the same subject as the current message
  331.        M A - mark messages with the same author as the current message
  332.        M a - unmark messages with the same author as the current message
  333.  
  334.        M ? - partial help for mark commands
  335.  
  336.  W S - save the current window configuration to a name
  337.  W D - delete a window configuration
  338.  W W - apply a configuration
  339.  W ? - help for the window configuration commands
  340.  
  341.  V V - visit a virtual folder (must be defined in vm-virtual-folder-alist)
  342.  V C - create a virtual folder composed of a subset of the
  343.        current folder's messages.
  344.  V A - apply the selectors of a named virtual folder to the
  345.        messages in the current folder and create a virtual folder
  346.        containing the selected messages.
  347.  V M - toggle whether this virtual folder's messages mirror the
  348.        underlying real messages' attributes.
  349.  V ? - help for virtual folder commands
  350.  
  351.  C-_ - undo, special undo that retracts the most recent
  352.              changes in message attributes and labels.  Expunges
  353.              message edits, and saves cannot be undone.  C-x u is
  354.              also bound to this command.
  355.  
  356.    a - set message attributes
  357.  
  358.  l a - add labels to message
  359.  l d - delete labels from message
  360.  
  361.    L - reload your VM init file, ~/.vm
  362.  
  363.    % - change a folder to another type
  364.  
  365.    ? - help
  366.  
  367.    ! - run a shell command
  368.    | - run a shell command with the current message as input
  369.  
  370.  M-C - view conditions under which you may redistribute VM
  371.  M-W - view the details of VM's lack of a warranty
  372.  
  373. Use M-x vm-submit-bug-report to submit a bug report.
  374.  
  375. Variables:
  376.    vm-arrived-message-hook
  377.    vm-arrived-messages-hook
  378.    vm-auto-center-summary
  379.    vm-auto-folder-alist
  380.    vm-auto-folder-case-fold-search
  381.    vm-auto-get-new-mail
  382.    vm-auto-next-message
  383.    vm-berkeley-mail-compatibility
  384.    vm-check-folder-types
  385.    vm-convert-folder-types
  386.    vm-circular-folders
  387.    vm-confirm-new-folders
  388.    vm-confirm-quit
  389.    vm-crash-box
  390.    vm-default-folder-type
  391.    vm-delete-after-archiving
  392.    vm-delete-after-bursting
  393.    vm-delete-after-saving
  394.    vm-delete-empty-folders
  395.    vm-digest-burst-type
  396.    vm-digest-center-preamble
  397.    vm-digest-preamble-format
  398.    vm-digest-send-type
  399.    vm-display-buffer-hook
  400.    vm-edit-message-hook
  401.    vm-folder-directory
  402.    vm-folder-read-only
  403.    vm-follow-summary-cursor
  404.    vm-forward-message-hook
  405.    vm-forwarded-headers
  406.    vm-forwarding-digest-type
  407.    vm-forwarding-subject-format
  408.    vm-frame-parameter-alist
  409.    vm-frame-per-composition
  410.    vm-frame-per-folder
  411.    vm-highlighted-header-face
  412.    vm-highlighted-header-regexp
  413.    vm-honor-page-delimiters
  414.    vm-in-reply-to-format
  415.    vm-included-text-attribution-format
  416.    vm-included-text-discard-header-regexp
  417.    vm-included-text-headers
  418.    vm-included-text-prefix
  419.    vm-inhibit-startup-message
  420.    vm-invisible-header-regexp
  421.    vm-jump-to-new-messages
  422.    vm-jump-to-unread-messages
  423.    vm-keep-sent-messages
  424.    vm-keep-crash-boxes
  425.    vm-mail-header-from
  426.    vm-mail-mode-hook
  427.    vm-mode-hook
  428.    vm-mosaic-program
  429.    vm-move-after-deleting
  430.    vm-move-after-undeleting
  431.    vm-move-messages-physically
  432.    vm-mutable-windows
  433.    vm-mutable-frames
  434.    vm-netscape-program
  435.    vm-options-file
  436.    vm-pop-md5-program
  437.    vm-preview-lines
  438.    vm-preview-read-messages
  439.    vm-primary-inbox
  440.    vm-quit-hook
  441.    vm-recognize-pop-maildrops
  442.    vm-reply-hook
  443.    vm-reply-ignored-reply-tos
  444.    vm-reply-ignored-addresses
  445.    vm-reply-subject-prefix
  446.    vm-resend-bounced-discard-header-regexp
  447.    vm-resend-bounced-headers
  448.    vm-resend-bounced-message-hook
  449.    vm-resend-discard-header-regexp
  450.    vm-resend-headers
  451.    vm-resend-message-hook
  452.    vm-retrieved-spooled-mail-hook
  453.    vm-rfc1153-digest-discard-header-regexp
  454.    vm-rfc1153-digest-headers
  455.    vm-rfc934-digest-discard-header-regexp
  456.    vm-rfc934-digest-headers
  457.    vm-search-using-regexps
  458.    vm-select-message-hook
  459.    vm-select-new-message-hook
  460.    vm-select-unread-message-hook
  461.    vm-send-digest-hook
  462.    vm-skip-deleted-messages
  463.    vm-skip-read-messages
  464.    vm-spool-files
  465.    vm-startup-with-summary
  466.    vm-strip-reply-headers
  467.    vm-summary-arrow
  468.    vm-summary-format
  469.    vm-summary-highlight-face
  470.    vm-summary-mode-hook
  471.    vm-summary-redo-hook
  472.    vm-summary-show-threads
  473.    vm-summary-subject-no-newlines
  474.    vm-summary-thread-indent-level
  475.    vm-trust-From_-with-Content-Length
  476.    vm-undisplay-buffer-hook
  477.    vm-unforwarded-header-regexp
  478.    vm-url-browser
  479.    vm-url-search-limit
  480.    vm-use-menus
  481.    vm-virtual-folder-alist
  482.    vm-virtual-mirror
  483.    vm-visible-headers
  484.    vm-visit-folder-hook
  485.    vm-visit-when-saving
  486.    vm-warp-mouse-to-new-frame
  487.    vm-window-configuration-file
  488. "
  489.   (interactive "P")
  490.   (vm (current-buffer) read-only)
  491.   (vm-display nil nil '(vm-mode) '(vm-mode)))
  492.  
  493. (defun vm-visit-folder (folder &optional read-only)
  494.   "Visit a mail file.
  495. VM will parse and present its messages to you in the usual way.
  496.  
  497. First arg FOLDER specifies the mail file to visit.  When this
  498. command is called interactively the file name is read from the
  499. minibuffer.
  500.  
  501. Prefix arg or optional second arg READ-ONLY non-nil indicates
  502. that the folder should be considered read only.  No attribute
  503. changes, messages additions or deletions will be allowed in the
  504. visited folder."
  505.   (interactive
  506.    (save-excursion
  507.      (vm-session-initialization)
  508.      (vm-select-folder-buffer)
  509.      (let ((default-directory (if vm-folder-directory
  510.                   (expand-file-name vm-folder-directory)
  511.                 default-directory))
  512.        (default (or vm-last-visit-folder vm-last-save-folder))
  513.        (this-command this-command)
  514.        (last-command last-command))
  515.        (list (vm-read-file-name
  516.           (format "Visit%s folder:%s "
  517.               (if current-prefix-arg " read only" "")
  518.               (if default
  519.               (format " (default %s)" default)
  520.             ""))
  521.           default-directory default nil nil 'vm-folder-history)
  522.          current-prefix-arg))))
  523.   (vm-session-initialization)
  524.   (vm-select-folder-buffer)
  525.   (vm-check-for-killed-summary)
  526.   (setq vm-last-visit-folder folder)
  527.   (let ((default-directory (or vm-folder-directory default-directory)))
  528.     (setq folder (expand-file-name folder)))
  529.   (vm folder read-only))
  530.  
  531. (defun vm-visit-folder-other-frame (folder &optional read-only)
  532.   "Like vm-visit-folder, but run in a newly created frame."
  533.   (interactive
  534.    (save-excursion
  535.      (vm-session-initialization)
  536.      (vm-select-folder-buffer)
  537.      (let ((default-directory (if vm-folder-directory
  538.                   (expand-file-name vm-folder-directory)
  539.                 default-directory))
  540.        (default (or vm-last-visit-folder vm-last-save-folder))
  541.        (this-command this-command)
  542.        (last-command last-command))
  543.        (list (vm-read-file-name
  544.           (format "Visit%s folder in other frame:%s "
  545.               (if current-prefix-arg " read only" "")
  546.               (if default
  547.               (format " (default %s)" default)
  548.             ""))
  549.           default-directory default nil nil 'vm-folder-history)
  550.          current-prefix-arg))))
  551.   (if (vm-multiple-frames-possible-p)
  552.       (vm-goto-new-frame 'folder))
  553.   (let ((vm-frame-per-folder nil)
  554.     (vm-search-other-frames nil))
  555.     (vm-visit-folder folder read-only))
  556.   (if (vm-multiple-frames-possible-p)
  557.       (vm-set-hooks-for-frame-deletion)))
  558.  
  559. (defun vm-visit-folder-other-window (folder &optional read-only)
  560.   "Like vm-visit-folder, but run in a different window."
  561.   (interactive
  562.    (save-excursion
  563.      (vm-session-initialization)
  564.      (vm-select-folder-buffer)
  565.      (let ((default-directory (if vm-folder-directory
  566.                   (expand-file-name vm-folder-directory)
  567.                 default-directory))
  568.        (default (or vm-last-visit-folder vm-last-save-folder))
  569.        (this-command this-command)
  570.        (last-command last-command))
  571.        (list (vm-read-file-name
  572.           (format "Visit%s folder in other window:%s "
  573.               (if current-prefix-arg " read only" "")
  574.               (if default
  575.               (format " (default %s)" default)
  576.             ""))
  577.           default-directory default nil nil 'vm-folder-history)
  578.          current-prefix-arg))))
  579.   (vm-session-initialization)
  580.   (if (one-window-p t)
  581.       (split-window))
  582.   (other-window 1)
  583.   (let ((vm-frame-per-folder nil)
  584.     (vm-search-other-frames nil))
  585.     (vm-visit-folder folder read-only)))
  586.  
  587. (put 'vm-virtual-mode 'mode-class 'special)
  588.  
  589. (defun vm-virtual-mode (&rest ignored)
  590.   "Mode for reading multiple mail folders as one folder.
  591.  
  592. The commands available are the same commands that are found in
  593. vm-mode, except that a few of them are not applicable to virtual
  594. folders.
  595.  
  596. vm-virtual-mode is not a normal major mode.  If you run it, it
  597. will not do anything.  The entry point to vm-virtual-mode is
  598. vm-visit-virtual-folder.")
  599.  
  600. (defun vm-visit-virtual-folder (folder-name &optional read-only)
  601.   (interactive
  602.    (let ((last-command last-command)
  603.      (this-command this-command))
  604.      (vm-session-initialization)
  605.      (list
  606.       (vm-read-string "Visit virtual folder: " vm-virtual-folder-alist)
  607.       current-prefix-arg)))
  608.   (vm-session-initialization)
  609.   (if (not (assoc folder-name vm-virtual-folder-alist))
  610.       (error "No such virtual folder, %s" folder-name))
  611.   (let ((buffer-name (concat "(" folder-name ")"))
  612.     first-time blurb)
  613.     (set-buffer (get-buffer-create buffer-name))
  614.     (setq first-time (not (eq major-mode 'vm-virtual-mode)))
  615.     (if first-time
  616.     (progn
  617.       (if (fboundp 'buffer-disable-undo)
  618.           (buffer-disable-undo (current-buffer))
  619.         ;; obfuscation to make the v19 compiler not whine
  620.         ;; about obsolete functions.
  621.         (let ((x 'buffer-flush-undo))
  622.           (funcall x (current-buffer))))
  623.       (abbrev-mode 0)
  624.       (auto-fill-mode 0)
  625.       (setq mode-name "VM Virtual"
  626.         mode-line-format vm-mode-line-format
  627.         buffer-read-only t
  628.         vm-folder-read-only read-only
  629.         vm-label-obarray (make-vector 29 0)
  630.         vm-virtual-folder-definition
  631.           (assoc folder-name vm-virtual-folder-alist))
  632.       (vm-build-virtual-message-list nil)
  633.       (use-local-map vm-mode-map)
  634.       (and (vm-menu-support-possible-p)
  635.            (vm-menu-install-menus))
  636.       ;; save this for last in case the user interrupts.
  637.       ;; an interrupt anywhere before this point will cause
  638.       ;; everything to be redone next revisit.
  639.       (setq major-mode 'vm-virtual-mode
  640.         ;; must come after the setting of major-mode
  641.         mode-popup-menu (and vm-use-menus
  642.                      (vm-menu-support-possible-p)
  643.                      (vm-menu-mode-menu)))
  644.       (setq blurb (vm-emit-totals-blurb))
  645.       (if vm-summary-show-threads
  646.           (vm-sort-messages "thread"))
  647.       (if (vm-thoughtfully-select-message)
  648.           (vm-preview-current-message)
  649.         (vm-update-summary-and-mode-line))
  650.       (message blurb)))
  651.     ;; make a new frame if the user wants one.  reuse an
  652.     ;; existing frame that is showing this folder.
  653.     (if (and vm-frame-per-folder (vm-multiple-frames-possible-p))
  654.     (let ((w (or (vm-get-buffer-window (current-buffer))
  655.              ;; summary == folder for the purpose
  656.              ;; of frame reuse.
  657.              (and vm-summary-buffer
  658.               (vm-get-buffer-window (current-buffer))))))
  659.       (if (null w)
  660.           (vm-goto-new-frame 'folder)
  661.         (save-excursion
  662.           (select-window w)
  663.           (and vm-warp-mouse-to-new-frame
  664.            (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))
  665.       (vm-set-hooks-for-frame-deletion)))
  666.     (vm-display (current-buffer) t nil nil)
  667.     (and (vm-toolbar-support-possible-p) vm-use-toolbar
  668.      (vm-toolbar-install-toolbar))
  669.     (if first-time
  670.     (if (vm-should-generate-summary)
  671.         (progn (vm-summarize t)
  672.            (message blurb))))
  673.     (vm-display nil nil '(vm-visit-virtual-folder
  674.               vm-visit-virtual-folder-other-frame
  675.               vm-visit-virtual-folder-other-window
  676.               vm-create-virtual-folder
  677.               vm-apply-virtual-folder)
  678.         (list this-command 'startup))
  679.     ;; check interactive-p so as not to bog the user down if they
  680.     ;; run this function from within another function.
  681.     (and (interactive-p) (not vm-inhibit-startup-message)
  682.      (not vm-startup-message-displayed)
  683.      (vm-display-startup-message)
  684.      (message blurb))))
  685.  
  686. (defun vm-visit-virtual-folder-other-frame (folder-name &optional read-only)
  687.   "Like vm-visit-virtual-folder, but run in a newly created frame."
  688.   (interactive
  689.    (let ((last-command last-command)
  690.      (this-command this-command))
  691.      (vm-session-initialization)
  692.      (list
  693.       (vm-read-string "Visit virtual folder in other frame: "
  694.                vm-virtual-folder-alist)
  695.       current-prefix-arg)))
  696.   (vm-session-initialization)
  697.   (if (vm-multiple-frames-possible-p)
  698.       (vm-goto-new-frame 'folder))
  699.   (let ((vm-frame-per-folder nil)
  700.     (vm-search-other-frames nil))
  701.     (vm-visit-virtual-folder folder-name read-only))
  702.   (if (vm-multiple-frames-possible-p)
  703.       (vm-set-hooks-for-frame-deletion)))
  704.  
  705. (defun vm-visit-virtual-folder-other-window (folder-name &optional read-only)
  706.   "Like vm-visit-virtual-folder, but run in a different window."
  707.   (interactive
  708.    (let ((last-command last-command)
  709.      (this-command this-command))
  710.      (vm-session-initialization)
  711.      (list
  712.       (vm-read-string "Visit virtual folder in other window: "
  713.                vm-virtual-folder-alist)
  714.       current-prefix-arg)))
  715.   (vm-session-initialization)
  716.   (if (one-window-p t)
  717.       (split-window))
  718.   (other-window 1)
  719.   (let ((vm-frame-per-folder nil)
  720.     (vm-search-other-frames nil))
  721.     (vm-visit-virtual-folder folder-name read-only)))
  722.  
  723. (defun vm-mail ()
  724.   "Send a mail message from within VM, or from without."
  725.   (interactive)
  726.   (vm-session-initialization)
  727.   (vm-select-folder-buffer)
  728.   (vm-check-for-killed-summary)
  729.   (vm-mail-internal)
  730.   (run-hooks 'vm-mail-hook)
  731.   (run-hooks 'vm-mail-mode-hook))
  732.  
  733. (defun vm-mail-other-frame ()
  734.   "Like vm-mail, but run in a newly created frame."
  735.   (interactive)
  736.   (vm-session-initialization)
  737.   (if (vm-multiple-frames-possible-p)
  738.       (vm-goto-new-frame 'composition))
  739.   (let ((vm-frame-per-composition nil)
  740.     (vm-search-other-frames nil))
  741.     (vm-mail))
  742.   (if (vm-multiple-frames-possible-p)
  743.       (vm-set-hooks-for-frame-deletion)))
  744.  
  745. (defun vm-mail-other-window ()
  746.   "Like vm-mail, but run in a different window."
  747.   (interactive)
  748.   (vm-session-initialization)
  749.   (if (one-window-p t)
  750.       (split-window))
  751.   (other-window 1)
  752.   (let ((vm-frame-per-composition nil)
  753.     (vm-search-other-frames nil))
  754.     (vm-mail)))
  755.  
  756. (defun vm-submit-bug-report ()
  757.   "Submit a bug report, with pertinent information to the VM bug list."
  758.   (interactive)
  759.   (require 'reporter)
  760.   ;; make sure the user doesn't try to use vm-mail here.
  761.   (let ((reporter-mailer '(mail)))
  762.     (delete-other-windows)
  763.     (reporter-submit-bug-report
  764.      vm-maintainer-address
  765.      (concat "VM " vm-version)
  766.      (list
  767.       'vm-arrived-message-hook
  768.       'vm-arrived-messages-hook
  769.       'vm-auto-center-summary
  770. ;; don't send this by default, might be personal stuff in here.
  771. ;;      'vm-auto-folder-alist
  772.       'vm-auto-folder-case-fold-search
  773.       'vm-auto-get-new-mail
  774.       'vm-auto-next-message
  775.       'vm-berkeley-mail-compatibility
  776.       'vm-check-folder-types
  777.       'vm-circular-folders
  778.       'vm-confirm-new-folders
  779.       'vm-confirm-quit
  780.       'vm-convert-folder-types
  781.       'vm-crash-box
  782.       'vm-default-folder-type
  783.       'vm-delete-after-archiving
  784.       'vm-delete-after-bursting
  785.       'vm-delete-after-saving
  786.       'vm-delete-empty-folders
  787.       'vm-digest-burst-type
  788.       'vm-digest-identifier-header-format
  789.       'vm-digest-center-preamble
  790.       'vm-digest-preamble-format
  791.       'vm-digest-send-type
  792.       'vm-display-buffer-hook
  793.       'vm-edit-message-hook
  794.       'vm-edit-message-mode
  795.       'vm-flush-interval
  796.       'vm-folder-directory
  797.       'vm-folder-read-only
  798.       'vm-follow-summary-cursor
  799.       'vm-forward-message-hook
  800.       'vm-forwarded-headers
  801.       'vm-forwarding-digest-type
  802.       'vm-forwarding-subject-format
  803.       'vm-frame-parameter-alist
  804.       'vm-frame-per-composition
  805.       'vm-frame-per-folder
  806.       'vm-highlight-url-face
  807.       'vm-highlighted-header-regexp
  808.       'vm-honor-page-delimiters
  809.       'vm-in-reply-to-format
  810.       'vm-included-text-attribution-format
  811.       'vm-included-text-discard-header-regexp
  812.       'vm-included-text-headers
  813.       'vm-included-text-prefix
  814.       'vm-inhibit-startup-message
  815.       'vm-init-file
  816.       'vm-invisible-header-regexp
  817.       'vm-jump-to-new-messages
  818.       'vm-jump-to-unread-messages
  819.       'vm-keep-crash-boxes
  820.       'vm-keep-sent-messages
  821.       'vm-mail-header-from
  822.       'vm-mail-hook
  823.       'vm-mail-mode-hook
  824.       'vm-mode-hook
  825.       'vm-mode-hooks
  826.       'vm-mosaic-program
  827.       'vm-move-after-deleting
  828.       'vm-move-after-undeleting
  829.       'vm-move-messages-physically
  830.       'vm-movemail-program
  831.       'vm-mutable-frames
  832.       'vm-mutable-windows
  833.       'vm-netscape-program
  834.       'vm-options-file
  835.       'vm-pop-md5-program
  836.       'vm-preview-lines
  837.       'vm-preview-read-messages
  838.       'vm-primary-inbox
  839.       'vm-quit-hook
  840.       'vm-recognize-pop-maildrops
  841.       'vm-reply-hook
  842.       'vm-reply-ignored-addresses
  843.       'vm-reply-ignored-reply-tos
  844.       'vm-reply-subject-prefix
  845.       'vm-resend-bounced-discard-header-regexp
  846.       'vm-resend-bounced-headers
  847.       'vm-resend-bounced-message-hook
  848.       'vm-resend-discard-header-regexp
  849.       'vm-resend-headers
  850.       'vm-resend-message-hook
  851.       'vm-retrieved-spooled-mail-hook
  852.       'vm-rfc1153-digest-discard-header-regexp
  853.       'vm-rfc1153-digest-headers
  854.       'vm-rfc934-digest-discard-header-regexp
  855.       'vm-rfc934-digest-headers
  856.       'vm-search-using-regexps
  857.       'vm-select-message-hook
  858.       'vm-select-new-message-hook
  859.       'vm-select-unread-message-hook
  860.       'vm-send-digest-hook
  861.       'vm-skip-deleted-messages
  862.       'vm-skip-read-messages
  863. ;; don't send vm-spool-files by default, might contain passwords
  864. ;;      'vm-spool-files
  865.       'vm-startup-with-summary
  866.       'vm-strip-reply-headers
  867.       'vm-summary-format
  868.       'vm-summary-highlight-face
  869.       'vm-summary-mode-hook
  870.       'vm-summary-mode-hooks
  871.       'vm-summary-redo-hook
  872.       'vm-summary-show-threads
  873.       'vm-summary-subject-no-newlines
  874.       'vm-summary-thread-indent-level
  875.       'vm-summary-uninteresting-senders
  876.       'vm-summary-uninteresting-senders-arrow
  877.       'vm-tale-is-an-idiot
  878.       'vm-trust-From_-with-Content-Length
  879.       'vm-undisplay-buffer-hook
  880.       'vm-unforwarded-header-regexp
  881.       'vm-url-browser
  882.       'vm-url-search-limit
  883.       'vm-use-menus
  884.       'vm-virtual-folder-alist
  885.       'vm-virtual-mirror
  886.       'vm-visible-headers
  887.       'vm-visit-folder-hook
  888.       'vm-visit-when-saving
  889.       'vm-warp-mouse-to-new-frame
  890.       'vm-window-configuration-file
  891. ;; see what the user had loaded
  892.       'features
  893.       )
  894.      nil
  895.      nil
  896.      "Please change the Subject header to a concise bug description.\nRemember to cover the basics, that is, what you expected to\nhappen and what in fact did happen.  Please remove these instructions from your message.")
  897.     (save-excursion
  898.       (goto-char (point-min))
  899.       (mail-position-on-field "Subject")
  900.       (beginning-of-line)
  901.       (delete-region (point) (progn (forward-line) (point)))
  902.       (insert "Subject: VM " vm-version " induces a brain tumor in the user.\n         It is the tumor that creates the hallucinations.\n"))))
  903.  
  904. (defun vm-load-init-file (&optional interactive)
  905.   (interactive "p")
  906.   (if (or (not vm-init-file-loaded) interactive)
  907.       (load vm-init-file (not interactive) (not interactive) t))
  908.   (setq vm-init-file-loaded t)
  909.   (vm-display nil nil '(vm-load-init-file) '(vm-load-init-file)))
  910.  
  911. (defun vm-session-initialization ()
  912.   ;; If this is the first time VM has been run in this Emacs session,
  913.   ;; do some necessary preparations.
  914.   (if (or (not (boundp 'vm-session-beginning))
  915.       vm-session-beginning)
  916.       (progn
  917.     (random t)
  918.     (vm-load-init-file)
  919.     (if (not vm-window-configuration-file)
  920.         (setq vm-window-configurations vm-default-window-configuration)
  921.       (or (vm-load-window-configurations vm-window-configuration-file)
  922.           (setq vm-window-configurations vm-default-window-configuration)))
  923.     (setq vm-buffers-needing-display-update (make-vector 29 0))
  924.     (and (vm-mouse-support-possible-p)
  925.          (vm-mouse-install-mouse))
  926.     (and (vm-menu-support-possible-p)
  927.          vm-use-menus
  928.          (vm-menu-fsfemacs-menus-p)
  929.          (vm-menu-initialize-vm-mode-menu-map))
  930.     (setq vm-session-beginning nil))))
  931.  
  932. (autoload 'reporter-submit-bug-report "reporter")
  933. (autoload 'timezone-make-date-sortable "timezone")
  934. (autoload 'rfc822-addresses "rfc822")
  935. (autoload 'mail-strip-quoted-names "mail-utils")
  936. (autoload 'mail-fetch-field "mail-utils")
  937. (autoload 'mail-position-on-field "mail-utils")
  938. (autoload 'mail-send "sendmail")
  939. (autoload 'mail-mode "sendmail")
  940. (autoload 'mail-extract-address-components "mail-extr")
  941. (autoload 'set-tapestry "tapestry")
  942. (autoload 'tapestry "tapestry")
  943. (autoload 'tapestry-replace-tapestry-element "tapestry")
  944. (autoload 'tapestry-nullify-tapestry-elements "tapestry")
  945. (autoload 'tapestry-remove-frame-parameters "tapestry")
  946. (autoload 'vm-easy-menu-define "vm-easymenu" nil 'macro)
  947. (autoload 'vm-easy-menu-do-define "vm-easymenu")
  948.